home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / run123.com / RUN123.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-16  |  9.1 KB  |  219 lines
  1. {══════════════════════════════ RUN123.PAS ═══════════════════════════════}
  2. { ───────────  Turbo 4.0/5.0 subprocess demonstration program  ────────── }
  3. {                 Copyright (c) 1989  Richard W. Prescott                 }
  4. { This program can be used to run 123.COM, load a designated worksheet,   }
  5. { and execute a series of keyboard entries (eg: printing a range, or      }
  6. { executing a macro) as specified on the RUN123 command line.             }
  7. { Illustrates how to modify the behavior of an existing program using     }
  8. { interrupt routines and executing the program as a subprocess.           }
  9. {                                                                         }
  10. { The Unit INTR16 contains the assembly code for the basic interrupt      }
  11. { routine, which is installed automatically by the "Uses INTR16" clause   }
  12. { and is detached automatically by the INTR16 Exit Code.  The assembly    }
  13. { code within INTR16 traps all Interrupt $16 (BIOS Keyboard Services)     }
  14. { requests and issues a FAR Call via the Pointer variable PascalCode      }
  15. { which is initialized in the MAIN block (below) to point to the          }
  16. { procedure StuffProc.  StuffProc returns the next character from the     }
  17. { command line for ReadChar and Status requests, chaining to the BIOS     }
  18. { Interrupt $16 handler for keyboard shift state requests.                }
  19. {                                                                         }
  20. { The Unit INTR16 provides the (Assembly) Inline Directives IChain for    }
  21. { chaining to the original interrupt routine, and IReturn for returning   }
  22. { directly to the calling program.  These may be called from any point    }
  23. { within the Pascal code.  The user registers at interrupt entry are      }
  24. { accessible through the record variable User^ (User^.Ax, User^.Flags,    }
  25. { etc).  They should be modified as necessary to simulate a successful    }
  26. { interrupt request before calling IReturn, as illustrated in the         }
  27. { procedure StuffProc.                                                    }
  28. {                                                                         }
  29. { The Unit T5DOS provides routines which are Call & Result compatible     }
  30. { with GetEnv, FSearch, and SwapVectors from the Turbo 5.0 DOS Unit.      }
  31. { They are used in the MAIN block (below) and are provided here for the   }
  32. { benefit of Turbo 4.0 Users.                                             }
  33. {══════════════════════════════ RUN123.PAS ═══════════════════════════════}
  34.  
  35. {$M $2400,0,0}
  36.  
  37. Uses            DOS,
  38. {$IFDEF VER40}  T5DOS,  {$ENDIF}
  39.                 INTR16;
  40.  
  41.  
  42. LABEL
  43.   Accumulate;
  44.  
  45. VAR
  46.   n,m: INTEGER;
  47.   AltLetter: CHAR;
  48.   SendScan: ARRAY[0..255] OF BYTE;
  49.   TempStr: STRING[255];
  50.   Path123: STRING[79];
  51.   PathLen: BYTE Absolute Path123;
  52.   SaveDir: STRING[67];
  53.  
  54. CONST 
  55.   SendLine: STRING[255] = '';
  56.   SendPos: Byte = 1;
  57.  
  58.   AltScan: ARRAY['A'..'Z'] OF BYTE = (
  59.    {A} 30,   {B} 48,   {C} 46,   {D} 32,   {E} 18,   {F} 33,   {G} 34,
  60.    {H} 35,   {I} 23,   {J} 36,   {K} 37,   {L} 38,   {M} 50,   {N} 49,
  61.    {O} 24,   {P} 25,   {Q} 16,   {R} 19,   {S} 31,   {T} 20,   {U} 22,
  62.    {V} 47,   {W} 17,   {X} 45,   {Y} 21,   {Z} 44  );
  63.  
  64.   MacroKey: ARRAY[1..25] OF
  65.   RECORD
  66.     Name: STRING[11];       Sc: BYTE; Ch: CHAR;
  67.   END  = (
  68.    (Name: '{DOWN}';         Sc: 80;   Ch: #0),
  69.    (Name: '{UP}';           Sc: 72;   Ch: #0),
  70.    (Name: '{LEFT}';         Sc: 75;   Ch: #0),
  71.    (Name: '{RIGHT}';        Sc: 77;   Ch: #0),
  72.    (Name: '{HOME}';         Sc: 71;   Ch: #0),
  73.    (Name: '{END}';          Sc: 79;   Ch: #0),
  74.    (Name: '{PGUP}';         Sc: 73;   Ch: #0),
  75.    (Name: '{PGDN}';         Sc: 81;   Ch: #0),
  76.    (Name: '{BIGLEFT}';      Sc: 115;  Ch: #0),
  77.    (Name: '{BIGRIGHT}';     Sc: 116;  Ch: #0),
  78.    (Name: '{EDIT}';         Sc: 60;   Ch: #0),
  79.    (Name: '{NAME}';         Sc: 61;   Ch: #0),
  80.    (Name: '{ABS}';          Sc: 62;   Ch: #0),
  81.    (Name: '{GOTO}';         Sc: 63;   Ch: #0),
  82.    (Name: '{WINDOW}';       Sc: 64;   Ch: #0),
  83.    (Name: '{QUERY}';        Sc: 65;   Ch: #0),
  84.    (Name: '{TABLE}';        Sc: 66;   Ch: #0),
  85.    (Name: '{CALC}';         Sc: 67;   Ch: #0),
  86.    (Name: '{GRAPH}';        Sc: 68;   Ch: #0),
  87.    (Name: '{DEL}';          Sc: 83;   Ch: #0),
  88.    (Name: '{DELETE}';       Sc: 83;   Ch: #0),
  89.    (Name: '{ESC}';          Sc: 0;    Ch: #27),
  90.    (Name: '{ESCAPE}';       Sc: 0;    Ch: #27),
  91.    (Name: '{BS}';           Sc: 0;    Ch: #08),
  92.    (Name: '{BACKSPACE}';    Sc: 0;    Ch: #08)   );
  93.  
  94.  
  95. {═══════════════════════════════ StuffProc ═══════════════════════════════} 
  96. { This is the Pascal code for the interrupt service routine, called from  }
  97. { INTR16.IHook.  For Read Character requests  (User^.Ah = 0 or $10),      }
  98. { return character and scan code of next character on the command line.   }
  99. { For Read Status requests  (User^.Ah = 1 or $11), clear User Zero Flag   }
  100. { to indicate key waiting and report character and scan code of next      }
  101. { character on the command line.  For all other requests, chain to the    }
  102. { BIOS Interrupt $16 handler.  When the command line is empty, detach     }
  103. { the interrupt routine to allow subsequent Keyboard Service requests to  }
  104. { be handled by the BIOS.                                                 }
  105. {═══════════════════════════════ StuffProc ═══════════════════════════════} 
  106. PROCEDURE StuffProc;
  107. BEGIN
  108. CASE User^.AH OF
  109.  
  110.   0,$10: IF SendPos <= Length(SendLine) THEN BEGIN
  111.        User^.AL := BYTE(SendLine[SendPos]);
  112.        User^.AH := SendScan[SendPos];
  113.        Inc(SendPos);
  114.        Ireturn;
  115.      END {0:  IF SendPos <= Length(SendLine) THEN }
  116.      ELSE BEGIN
  117.        Irestore;
  118.        Ichain;
  119.      END; {ELSE }
  120.  
  121.   1,$11: IF SendPos <= Length(SendLine) THEN BEGIN
  122.        User^.AL := BYTE(SendLine[SendPos]);
  123.        User^.AH := SendScan[SendPos];
  124.        User^.Flags := User^.Flags AND $FFBF; {Clear ZF}
  125.        Ireturn;
  126.      END {0:  IF SendPos <= Length(SendLine) THEN }
  127.      ELSE BEGIN
  128.        Irestore;
  129.        Ichain;
  130.      END; {ELSE }
  131.  
  132.   else Ichain;
  133.  
  134. END; {CASE User.AH }
  135.  
  136. END; {PROCEDURE StuffProc; }
  137.  
  138.  
  139. {══════════════════════════════════ MAIN ═════════════════════════════════}
  140. { Translate and store keystrokes indicated on command line, initialize    }
  141. { PascalCode Pointer, change to 123 directory, and Exec 123.COM.  On      }
  142. { return, restore original directory.                                     }
  143. {══════════════════════════════════ MAIN ═════════════════════════════════}
  144. BEGIN {- MAIN -}
  145.   FillChar(SendScan,256,#0);
  146.  
  147. {═════ Process Command Line for "~", Macro, and Alt- Key translation ═════}
  148.  
  149. {═══ If first command is not "/", assume it is a file name to retrieve ═══}
  150.   SendLine := ParamStr(1);
  151.   IF (SendLine <> '')
  152.   AND (SendLine[1] <> '/') 
  153.   THEN SendLine := '/fr' + ParamStr(1) + #13;
  154.  
  155.   For n := 2 TO ParamCount DO BEGIN
  156.  
  157.     TempStr := ParamStr(n);
  158.  
  159. {════════════════════ Translate "~" to carriage return ═══════════════════}
  160.     m := Pos('~',TempStr);
  161.     WHILE m>0 DO BEGIN
  162.       TempStr[m] := #13;    m := Pos('~',TempStr);
  163.     END; {WHILE m>0 DO }
  164.  
  165. {═════════════════════════ Translate macro keys ══════════════════════════}
  166.     IF TempStr[1]='{' THEN BEGIN
  167.       FOR m := 1 TO Length(TempStr) DO TempStr[m] := UpCase(TempStr[m]);
  168.       FOR m := 1 TO 25 DO IF TempStr = MacroKey[m].Name THEN BEGIN
  169.         SendScan[ 1 + Length(SendLine) ] := MacroKey[m].Sc;
  170.         TempStr := MacroKey[m].Ch;
  171.         GOTO Accumulate;
  172.       END; {FOR m := 1 TO 25 DO IF TempStr = MacroKey[m].Name THEN }
  173.       WRITELN('Invalid Macro Key ',TempStr,' Specified'); Halt(2);
  174.     END; {IF TempStr[1]='{' THEN }
  175.  
  176. {══════════════════════════ Translate Alt- Keys ══════════════════════════}
  177.     IF TempStr[1]='\' THEN BEGIN
  178.       Delete(TempStr,1,1);
  179.       AltLetter:= UpCase(TempStr[1]);
  180.       IF NOT (AltLetter IN ['A'..'Z']) THEN BEGIN
  181.         WRITELN('Invalid Macro \',AltLetter,' Specified'); Halt(2);
  182.       END; {IF NOT AltLetter IN ('A'..'Z') THEN }
  183.  
  184.       SendScan[ 1 + Length(SendLine) ] := AltScan[AltLetter];
  185.       TempStr[1] := #0;
  186.     END; {IF TempStr[1]='\' THEN }
  187.  
  188. {═══════════ Accumulate translated parameters in VAR SendLine ════════════}
  189. Accumulate:
  190.     SendLine := SendLine + TempStr;
  191.  
  192.   END; {For n := 2 TO ParamCount DO }
  193.  
  194.  
  195. {══════════ Initialize PascalCode Pointer to StuffProc (above) ═══════════}
  196.   PascalCode := @StuffProc;
  197.  
  198. {════════════════ Search current Dir and Path for 123.COM ════════════════}
  199.   Path123 := FSearch('123.COM',GetEnv('PATH'));
  200.  
  201.  
  202. {═════════════ If found, change directories and execute 123 ══════════════}
  203.   IF Path123 = '' 
  204.   THEN WRITELN('123.COM NOT FOUND')
  205.   ELSE BEGIN
  206.     PathLen := Pos('123.COM',Path123) -1;  {- Determine 123 Directory -}
  207.     IF   (Path123[PathLen] = '\')          {- Remove trailing '\'     -}
  208.     AND  (Path123[PathLen-1] <> ':')       {-  .. except for Root Dir -}
  209.     THEN Dec(PathLen);
  210.     GetDir(0,SaveDir);                     {- Save Current Directory  -}
  211.     IF Path123<>'' THEN ChDir(Path123);    {- Change to 123 Directory -}
  212.     SwapVectors;
  213.     Exec('123.COM','');                    {- Execute 123.COM         -}
  214.     SwapVectors;
  215.     ChDir(SaveDir);                        {- Restore Directory       -}
  216.   END; {ELSE }
  217.  
  218. END.
  219.